Import data

df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
full <- df_coop_homo %>%
  rbind(df_coop_max) %>%
  rbind(df_coop_min) %>%
  mutate(tournament_type = case_when(
    tournament_type == "pareto_m_min" ~ "pareto_m_max",
    tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
    tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
    tournament_type == "pareto_m_max" ~ "pareto_m_min",
    tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
    tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
    TRUE ~ as.character(tournament_type))
    )
rm(df_coop_homo,df_coop_max,df_coop_min)

Cooperation Ratio

Analysis of cooperation ratio

full %>%
  group_by(tournament_type, seed) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  ggplot(aes(x = as.factor(tournament_type), y = mean_coop, fill = tournament_type)) +
  geom_bar(stat="identity") +
  geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
  facet_wrap(~seed) +
  coord_flip() +
  scale_fill_grey(guide = F) +
  labs(title = "Mean cooperation ratio and standard deviation per tournament type, facetted by seed",
       y = "cooperatio ratio",
       x = " ")

full %>%
  group_by(tournament_type, seed) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  ggplot(aes(x = as.factor(seed), y = mean_coop, fill = tournament_type)) +
    geom_bar(stat="identity") +
    geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
    facet_wrap(~tournament_type) +
    coord_flip() +
    scale_fill_grey(guide = F) +
    labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
         y = "cooperatio ratio",
         x = " ")

full %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  arrange(desc(mean_coop)) %>%
  kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by mean of cooperation ratio
tournament_type mean_coop sd_coop
hetero_dr_sd_max 0.6002804 0.1605549
homogenous 0.5892130 0.1542594
pareto_m_min 0.5886649 0.1566004
hetero_m_sd_max 0.5859083 0.1568820
pareto_mdr_min 0.5825757 0.1616499
hetero_mdr_sd_max 0.5817933 0.1660426
hetero_m_sd_min 0.5799698 0.1605414
pareto_dr_min 0.5795952 0.1543603
hetero_mdr_sd_min 0.5793128 0.1596192
hetero_dr_sd_min 0.5789166 0.1612046
pareto_m_max 0.5747713 0.1575829
pareto_mdr_max 0.5715410 0.1618162
pareto_dr_max 0.5713618 0.1638552 
full %>%
  group_by(tournament_type) %>%
  summarise(mean_coop = mean(coop_ratio),
            sd_coop = sd(coop_ratio)) %>%
  arrange(desc(sd_coop)) %>%
  kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by s.d. of cooperation ratio
tournament_type mean_coop sd_coop
hetero_mdr_sd_max 0.5817933 0.1660426
pareto_dr_max 0.5713618 0.1638552
pareto_mdr_max 0.5715410 0.1618162
pareto_mdr_min 0.5825757 0.1616499
hetero_dr_sd_min 0.5789166 0.1612046
hetero_dr_sd_max 0.6002804 0.1605549
hetero_m_sd_min 0.5799698 0.1605414
hetero_mdr_sd_min 0.5793128 0.1596192
pareto_m_max 0.5747713 0.1575829
hetero_m_sd_max 0.5859083 0.1568820
pareto_m_min 0.5886649 0.1566004
pareto_dr_min 0.5795952 0.1543603
homogenous 0.5892130 0.1542594

Comparing the control group with heterogenous groups__

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_dr_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_m_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_mdr_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_dr_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_m_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_mdr_sd_max", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_dr_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_m_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("hetero_mdr_sd_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_dr_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_m_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F) 

full %>%
  group_by(seed, tournament_type) %>%
  mutate(round = row_number()) %>%
  ungroup() %>%
  filter(str_detect(tournament_type, c("pareto_mdr_min", "homogenous"))) %>%
  ggplot(aes(round, coop_ratio, color = tournament_type)) +
  geom_smooth(color = "black") +
  #geom_point(color = "black") +
  facet_wrap(tournament_type~seed) +
  scale_color_grey(guide = F)

Stability

Data Prep

Data import

Comparison of All Groups

my_formula <- y ~ x

df_outliers_full %>%
  ggplot() +
  geom_point(aes(S.D., Counts, color = as.factor(seed))) +
  geom_smooth(aes(S.D., Counts), color = "black") +
  facet_wrap(~tournament_type) +
      scale_color_grey(guide = F) +
  labs(title = "Smooth function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  filter(S.D. <= 1.5) %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Range of S.D. limited from 0 to 1.5",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  filter(S.D. >= 1.5) %>%
  select(x = S.D., y = Counts, tournament_type, seed) %>%
    ggplot(aes(x = x, y = y)) +
      geom_point(aes(x, y, color = as.factor(seed))) +
      geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
      stat_poly_eq(formula = my_formula, 
                   aes(label = paste(..eq.label.., sep = "~~~")), 
                   parse = TRUE,
                   label.x = 2) +         
      facet_wrap(~tournament_type) +
            scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Range of S.D. limited from 1.5 to 3",
       x = "standard deviation",
       y = "count of outliers")

df_outliers_full %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Intercept)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
pareto_dr_min 318.9619 -124.5255 0.9151360
control_group 313.9496 -121.9624 0.9149856
pareto_m_min 309.6571 -120.7227 0.9116794
norm_m_sd_max 305.0884 -118.9032 0.9102347
norm_mdr_sd_min 304.7535 -119.0130 0.9043898
pareto_mdr_max 300.6716 -117.2629 0.9114020
pareto_m_max 299.2762 -116.3644 0.9159300
norm_dr_sd_min 295.8781 -115.0315 0.9208328
pareto_dr_max 295.6928 -115.4574 0.9107716
norm_m_sd_min 294.6364 -114.5549 0.9221166
pareto_mdr_min 293.8838 -114.2017 0.9117865
norm_dr_sd_max 293.4010 -114.0533 0.9138033
norm_mdr_sd_max 290.0874 -112.9884 0.9226192 
df_outliers_full %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
norm_mdr_sd_max 290.0874 -112.9884 0.9226192
norm_dr_sd_max 293.4010 -114.0533 0.9138033
pareto_mdr_min 293.8838 -114.2017 0.9117865
norm_m_sd_min 294.6364 -114.5549 0.9221166
norm_dr_sd_min 295.8781 -115.0315 0.9208328
pareto_dr_max 295.6928 -115.4574 0.9107716
pareto_m_max 299.2762 -116.3644 0.9159300
pareto_mdr_max 300.6716 -117.2629 0.9114020
norm_m_sd_max 305.0884 -118.9032 0.9102347
norm_mdr_sd_min 304.7535 -119.0130 0.9043898
pareto_m_min 309.6571 -120.7227 0.9116794
control_group 313.9496 -121.9624 0.9149856
pareto_dr_min 318.9619 -124.5255 0.9151360 
df_outliers_full %>%
  filter(S.D. <= 2) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  mutate(Var = -Intercept/Slope) %>%
  arrange(Var) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2 Var
norm_m_sd_max 363.3324 -169.1309 0.9643471 2.148232
norm_mdr_sd_min 362.6412 -168.7279 0.9541591 2.149266
pareto_dr_max 349.6566 -161.9103 0.9529084 2.159570
pareto_m_max 354.8750 -164.2500 0.9712504 2.160578
pareto_dr_min 375.8412 -173.1779 0.9652927 2.170260
pareto_m_min 364.4471 -167.6676 0.9524959 2.173628
pareto_mdr_max 353.1904 -162.3074 0.9457772 2.176059
pareto_mdr_min 345.8625 -158.9000 0.9481187 2.176605
norm_dr_sd_max 343.8375 -157.2000 0.9508106 2.187261
control_group 366.5375 -166.9000 0.9490888 2.196150
norm_dr_sd_min 342.9221 -155.1676 0.9504934 2.210010
norm_mdr_sd_max 336.2353 -152.0632 0.9655064 2.211154
norm_m_sd_min 341.5154 -154.4324 0.9585277 2.211424 
df_outliers_full %>%
  filter(S.D. <= 2) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  arrange(desc(Slope)) %>%
  kable() %>%
  kable_styling()
as.factor(tournament_type) Intercept Slope R2
norm_mdr_sd_max 336.2353 -152.0632 0.9655064
norm_m_sd_min 341.5154 -154.4324 0.9585277
norm_dr_sd_min 342.9221 -155.1676 0.9504934
norm_dr_sd_max 343.8375 -157.2000 0.9508106
pareto_mdr_min 345.8625 -158.9000 0.9481187
pareto_dr_max 349.6566 -161.9103 0.9529084
pareto_mdr_max 353.1904 -162.3074 0.9457772
pareto_m_max 354.8750 -164.2500 0.9712504
control_group 366.5375 -166.9000 0.9490888
pareto_m_min 364.4471 -167.6676 0.9524959
norm_mdr_sd_min 362.6412 -168.7279 0.9541591
norm_m_sd_max 363.3324 -169.1309 0.9643471
pareto_dr_min 375.8412 -173.1779 0.9652927

Determining slope and start of instability

df_slope_intercept <- df_outliers_full %>%
  filter(S.D. <= 2) %>%
  group_by(as.factor(tournament_type)) %>%
    do({
      mod = lm(Counts ~ S.D., data = .)
      data.frame(Intercept = coef(mod)[1],
                 Slope = coef(mod)[2],
                 R2 = summary(mod)$r.squared)
    }) %>%
  mutate(Var = -Intercept/Slope) %>%
  select(tournament_type = `as.factor(tournament_type)`, everything()) %>%
  right_join(df_outliers_full)  

df_slope_intercept %>%
  mutate(Intercept = round(Intercept, 0),
         Slope = round(Slope, 0),
         Var = round(Var, 2)) %>%
  mutate(Formula = str_c("alpha:", Intercept, "m:", Slope, "v:", Var, sep = " ")) %>%
  ggplot() +
  geom_point(aes(S.D., Counts, color = as.factor(seed))) +
  geom_abline(aes(intercept = Intercept, slope = Slope)) +
  geom_hline(yintercept = 0) +
  geom_text(aes(2.2, 300, label = Formula), size = 2.5) +
  facet_wrap(~tournament_type) +
              scale_color_grey(guide = F) +
  labs(title = "Linear function applied to count of outliers on standard deviation",
       subtitle = "Slope calculated for S.D. < 2",
       x = "standard deviation",
       y = "count of outliers")